home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / ENTRECAL.SRC < prev    next >
Text File  |  1990-11-03  |  5KB  |  235 lines

  1. ;\|
  2. ;ENTRECAL.SRC     Translated from ENTRECAL.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;REPONLY  12:02:57 PM  28/ 3/90                    |
  4.     define(P29|A|29||)
  5.     define(ANS|A|1||)
  6.     define(COUNTER|N|4||)
  7.     define(TD|D|10||)
  8.     define(PR_CTR|N|2||)
  9.     define(TOTAL_MATCH|N|8|0|)
  10.     define(PER_CENT|N|3||)
  11.     define(TOTAL_MAT_CRIT|N|4||)
  12.     define(PERCENTAGE|N|8|2|)
  13.     define(REC_DATE|S|8||)
  14.     define(COUNT|N|4||)
  15.     define(SELECT.FLD.F1|A|  4||)
  16.     define(SELECT.FLD.T1|A|  4||)
  17.     define(SELECT.FLD.F2|S|  8||)
  18.     define(SELECT.FLD.T2|S|  8||)
  19.     define(SFT|A|1||)
  20.     define(DOB1|D|10||)
  21.     define(DOB2|D|10||)
  22.     define(CTR|N|1||)
  23.     define(MEM_DATE|S|8||)
  24.     define(FROM_DATE|S|8||)
  25.     define(MEM_COD|A|4||)
  26.     define(ENTER|A|1||)
  27.     define(FLAG|A|1||)
  28.     define(FLAG2|A|1||)
  29.     open(RECALLS||0|EXIT)
  30.     open(PATIENT||0|EXIT)
  31.     trap(Q|G|EXIT)
  32.     trap(I|G|EXIT)
  33.     date(TD|G)
  34.     mount(SELECT|S||)
  35. START:
  36.     enter(FROM_DATE||||N|N|N|||N)
  37.     enter(CTR|"135"|||N|Y|N|||N)
  38.     SELECT.FLD.F1 = ("****")
  39.     enter(SFT|" MF"|||Y|Y|N|||N)
  40.     if CTR = (1) then DOB1 = (FROM_DATE-23741)
  41.     if CTR = (3) then DOB1 = (FROM_DATE-2190)
  42.     enter(DOB1||||N|Y|N|||N)
  43.     if CTR = (1) then DOB2 = (FROM_DATE-9131)
  44.     if CTR = (3) then DOB2 = (FROM_DATE)
  45.     enter(DOB2||||N|Y|N|||N)
  46. FLAG_AGAIN:
  47.     enter(FLAG|"YN"|||Y|Y|N|||N)
  48.     if FLAG = ("Y") do
  49.         {
  50.         pmsg("DO YOU REALLY WANT TO ADD NAMES AT RISK TO THE RECALL REGISTER Y/N"|1|21|Y|N|S|FLAG)
  51.         if FLAG <> ("Y") goto FLAG_AGAIN
  52.         }
  53.     pmsg("IS ALL THE ABOVE CORRECT? Y/N:"|30|22|Y|N|S|ENTER)
  54.     if ENTER <> ("Y") then goto START
  55.     pchr(P|4)
  56.     pchr(P|1)
  57.     pset(100|66|66)
  58.     for(PR_CTR|1|20|1)
  59.         {
  60.         pmsg(""|1|1|N|N|P|)
  61.         }
  62.     pmsg("**** ADDED STARTING ON :";FROM_DATE;"  USING FOLLOWING CRITERIA:"|1|1|N|N|P|)
  63.     pmsg("======================================================================"|1|1|N|N|P|)
  64.     pmsg("RECALL TYPE NUMBER: ";CTR|1|1|N|N|P|)
  65.     pmsg("SEX = ";SFT|1|1|N|N|P|)
  66.     pmsg("FROM DATE OF BIRTH: ";DOB1;" TO DATE OF BIRTH: ";DOB2|1|1|N|N|P|)
  67.     pmsg(""|1|1|N|N|P|)
  68.     pmsg("====================================================================="|1|1|N|N|P|)
  69.     for(PR_CTR|1|39|1)
  70.         {
  71.         pmsg(""|1|1|N|N|P|)
  72.         }
  73.     trap(I|G|FINI)
  74.     mount(SCREEN|R|P)
  75.     ptof
  76.     pchr(P|4)
  77.     pset(132|66|60)
  78.     pchr(P|1)
  79.     DATE.OF.BIRTH = (DOB1)
  80.     find(G|DATE.OF.BIRTH|NO.RECS|)
  81.     P29 = (PATIENT.NAME)
  82.     goto TESTIT
  83. PRT.REC:
  84.     COD.REF = (RECORD.NUMBER)
  85.     find(M|COD.REF|PRINTITX|N)
  86.     goto PRINTITX
  87. RD.NEXT:
  88.     clr(RECALLS|B)
  89.     find(N|PATIENT|FINI|)
  90.     if DATE.OF.BIRTH > (DOB2) goto FINI
  91.     pmsg(DATE.OF.BIRTH|1|1|N|N|S|)
  92.     P29 = (PATIENT.NAME)
  93.     goto TESTIT
  94. FINI:
  95.     pmsg("TOTAL AT RISK:";TOTAL_MATCH|1|1|N|N|P|)
  96.     pmsg("TOTAL NEW RISKS:";TOTAL_MAT_CRIT|1|1|N|N|P|)
  97.     run("recmenu")
  98. NO.RECS:
  99.     pmsg("There are no records in the RECALLS  file "|1|24|Y|||)
  100. EXIT:
  101.     run("recmenu")
  102. TESTIT:
  103.     if SFT <> ("") then if SEX <> (SFT) goto RD.NEXT
  104.     if DOB1 <> (0) then if DOB1 > (DATE.OF.BIRTH) goto RD.NEXT
  105.     if DOB2 <> (0) then if DOB2 < (DATE.OF.BIRTH) goto RD.NEXT
  106.     TOTAL_MATCH = (TOTAL_MATCH+1)
  107.     goto PRT.REC
  108. PRINTITX:
  109.     if COD[CTR] > ("") goto RD.NEXT
  110.     if COD.D[CTR] > (0) goto RD.NEXT
  111.     COD[CTR] = (SELECT.FLD.F1)
  112.     COD.REF = (RECORD.NUMBER)
  113.     COD.PAT.NAME = (P29)
  114.     TOTAL_MAT_CRIT = (TOTAL_MAT_CRIT+1)
  115.     pfmt(2|||N|N|)
  116.     save(RECALLS|N|Y)
  117.     goto RD.NEXT
  118. DEL_RECS:
  119.     pmsg("YOU ARE ABOUT TO DELETE SMEAR RECORDS OF ALL WOMEN BORN BEFORE: ";DOB1|1|2|N|N|S|)
  120.     pmsg("DO YOU WISH TO CONTINUE? Y/N : "|1|3|Y|N|S|)
  121.     enter(ANS|"YN"|||Y|Y|N|31|3|N)
  122.     if ANS <> ("Y") then run("recmenu")
  123.     clrlne(1|2)
  124.     clrlne(1|3)
  125.     find(B|COD.REF|EXIT|)
  126.     goto TEST_AGE
  127. TEST_AGE:
  128.     pmsg(RECORD.NUMBER|1|1|N|N|S|)
  129.     RECORD.NUMBER = (COD.REF)
  130.     find(M|RECORD.NUMBER|EXIT|)
  131.     if DATE.OF.BIRTH < (DOB1) do
  132.         {
  133.         if COD[1] > ("") then COD[1] = ("")
  134.         if COD.D[1] > (0) then COD.D[1] = (0)
  135.         if SM_DATE > (0) then SM_DATE = (0)
  136.         save(RECALLS|N|Y)
  137.         }
  138.     find(N|RECALLS|NEW_START|)
  139.     goto TEST_AGE
  140. NEW_START:
  141.     ret
  142. \STSELECT  
  143.  
  144.  
  145.  
  146.  
  147.  THIS PROGRAM WILL MARK THOSE AT RISK WITH **** IN THE CODE - SMEARS/IMMUN
  148.  ENTERING TARGET DATE WILL ANTICIPATE NEARLY CORRECT DATES FOR GIVEN PERIOD
  149.  TARGETS ARE FPC QUARTERS -
  150. ╔═══════╗
  151. ║Targets║    ╔═════════════════════════════════════════════════════╗
  152. ║ 01/04 ║    ║        Target Date:&         eg 01/04/90            ║
  153. ║ 01/07 ║    ║          RECALL NO:&  eg 1 = smears 3 = immun       ║
  154. ║ 01/10 ║    ║              Sex : &  Blank for immunisations       ║
  155. ║ 01/01 ║    ║ Date of Birth from:&           01/??/??             ║
  156. ╚═══════╝    ║ Date of Birth to  :&           01/??/??             ║
  157.              ╚═════════════════════════════════════════════════════╝
  158.               Esc to STOP       CONTINUE Y/N:&
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167. \
  168. FROM_DATE
  169. CTR
  170. SFT
  171. DOB1
  172. DOB2
  173. FLAG
  174. \
  175. \R SCREEN  
  176. &                                &                      &           (&   ) &
  177. &                                &                      &            NO RECALL ON FILE - recall added
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224. \
  225. P29
  226. ADDRESS1
  227. DATE.OF.BIRTH
  228. MEM_COD
  229. MEM_DATE
  230. P29
  231. ADDRESS1
  232. DATE.OF.BIRTH
  233. \
  234.  
  235.